home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / cmln0586.arc / CONTOUR.PAS < prev    next >
Pascal/Delphi Source File  |  1986-04-06  |  24KB  |  937 lines
  1.  
  2.  
  3.                            CONTOUR.PAS
  4.            Taken from J. C. Johnston's article in the
  5.           May 1986 issue of Computer Language magazine
  6.  
  7.  
  8.  
  9. program Contour;
  10.  
  11. {     Copyright (C) 1983 by J.C. Johnston
  12.  
  13.       This program displays contour plots of 2D-NMR data on a
  14.         digital plotter. The plotter is determined through choice
  15.         of plotter include file.
  16.       It was written to allow contour plotting of the data and to
  17.         make use of the smaller linewidth and higher resolution of
  18.         the digital plotter over the Tektronix 4006-1/Printronix
  19.         system.
  20. }
  21.  
  22. const
  23.       BoxSideOffset           = 3800;     {right side of contour box}
  24.       BoxTopOffset            = 2400;     {top of contour box}
  25.       DateLength              = 11;       {length of date string}
  26.       DateX                   = 3000;è      DateY                   = 20;
  27.       InitialDisplayIndex     = 1;
  28.       InitX                   = 150;      {initial x position}
  29.       InitY                   = 200;      {initial y position}
  30.       LengthBetweenXTicks     = 380;
  31.       LengthBetweenYTicks     = 240;
  32.       MaxNumberOfPoints       = 2048;
  33.       PointsPerDisplayArray   = 129;
  34.       TitleXStart             = 500;
  35.       TitleYStart             = 20;
  36.       XFlipPoint              = 2001;
  37.       XXCharOffset            = 50;
  38.       XYCharOffset            = 50;
  39.       YXCharOffset            = 150;
  40.       YYCharOffset            = -10;
  41.  
  42. type
  43.       DisplayArrayType  = ARRAY[1..PointsPerDisplayArray] of INTEGER;
  44.  
  45.       DisplayFileType   = FILE of DisplayArrayType;
  46.  
  47.       FileNameType      = string[20];
  48.  
  49.       AlphaDirection    = (Horizontal, Vertical, HorizInv, VertInv);
  50.  
  51.       TickyType         = (ON,OFF);
  52.  
  53.       CharSizeType      = (Small, Medium, Large);
  54.  
  55. var
  56.       DisplayFile       : DisplayFileType;
  57.  
  58.       DisplayFileName   : FileNameType;
  59.  
  60.       Date              : String[12];
  61.  
  62.       TextString        : String[20];
  63.  
  64.       VExpand           : BOOLEAN;
  65.  
  66.  
  67.       Offset,
  68.       LastX,                        {after Ready sets these variables NO ONE}
  69.       LastY,                        {except MoveTo should change them.}
  70.       CurrentX,                     {these, you can change}
  71.       CurrentY,
  72.       NumberOfDisplayArrays,        {length of long axis in points}
  73.       NumberOfDisplayPoints,        {length of short axis in points}
  74.       MaxZ,                         {greatest Z axis point}
  75.       XEnd,                         {end of X axis in real units (Hz., etc.)}
  76.       XStart,                       {beginning of X axis in real units}
  77.       YEnd,                         {end of Y axis in real units}
  78.       YStart      : INTEGER;        {beginning of Y axis in real units}
  79.  
  80.       BEEP,è      CR,
  81.       ESCAPE,
  82.       Chars,
  83.       Choice            : CHAR;
  84.  
  85.       Tick        : TickyType;
  86.  
  87.       CharSize    : CharSizeType;
  88.  
  89. procedure ReadData;
  90.  
  91. { Reads important data from element 0 of data array}
  92.  
  93. var
  94.   TempArray : DisplayArrayType;
  95.  
  96. begin
  97.   seek(DisplayFile, 0);
  98.   read(DisplayFile, TempArray);
  99.  
  100.   NumberOfDisplayArrays := TempArray[1];
  101.   NumberOfDisplayPoints := TempArray[2];
  102.   MaxZ        := TempArray[3];
  103.   XEnd        := TempArray[4];
  104.   XStart      := TempArray[5];
  105.   YEnd        := TempArray[6];
  106.   YStart      := TempArray[7];
  107.  
  108. end;  {ReadData}
  109.  
  110. {$I PLOTTER.PAS}
  111.  
  112. procedure GetDate;
  113.  
  114. { It gets and plots the date and title}
  115.  
  116. begin
  117.   TextString := '25-Feb-1986';
  118.   MoveTo(DateX, DateY);
  119.   PrintText(Medium, Horizontal);
  120.   Title;
  121. end; {GetDate}
  122.  
  123. procedure Contour;
  124.  
  125. const
  126.       MaxEdgesToTraverse = 7;
  127.       ContourXOffset     = 150;
  128.       ContourYOffset     = 200;
  129.       ContourXScale      = 3800.00;
  130.       ContourYScale      = 2400.00;
  131. type
  132.       MapType            = ARRAY[0..15, 1..8] of INTEGER;
  133.  
  134.       ContourValueType   = ARRAY[1..15] of INTEGER;è
  135.       PointArrayType     = ARRAY[1..5] of INTEGER;
  136.  
  137.       TraverseArrayType  = ARRAY[1..2 , 1..MaxEdgesToTraverse] of INTEGER;
  138.  
  139. var
  140.       I,
  141.       TerminalCount,
  142.       DisplayCount,
  143.       FileIndexOffset,
  144.       CellXPosition,
  145.       CellYPosition,
  146.       RightCellEdge,
  147.       RightCellIndex,
  148.       FinalDisplayIndex,
  149.       ContourCount,
  150.       ContourNumber,
  151.       StartEdge,
  152.       EndEdge,
  153.       FileIndex,
  154.       MapIndex          : INTEGER;
  155.  
  156.       XScale,
  157.       YScale,
  158.       VExFactor         : REAL;
  159.  
  160.       Point             : PointArrayType;
  161.  
  162.       ContourValue      : ContourValueType;
  163.  
  164.       Traverse          : TraverseArrayType;
  165.  
  166.       Map               : MapType;
  167.  
  168.       ContourArrayA,
  169.       ContourArrayB     : DisplayArrayType;
  170.  
  171. procedure MoveBToA;
  172.  
  173. {     Moves contour array b to contour array A. }
  174.  
  175. var
  176.       I     : INTEGER;
  177.  
  178. begin
  179.   for I := 1 to NumberOfDisplayPoints do
  180.     ContourArrayA[I] := ContourArrayB[I];
  181. end;  {MoveBToA}
  182.  
  183. procedure VerticalExpand;
  184.  
  185. var
  186.       I     : INTEGER;
  187.  
  188.       RTemp : REAL;è
  189. begin
  190.   for I := 1 to NumberOfDisplayPoints do
  191.     begin
  192.       RTemp := ContourArrayB[I] * VExFactor;
  193.       if RTemp > MaxZ
  194.       then RTemp := MaxZ;
  195.       ContourArrayB[I] := Round(RTemp);
  196.     end;
  197. end; {VerticalExpand}
  198.  
  199. procedure InitMap;
  200.  
  201.       { Initialize the map }
  202.  
  203. var
  204.       I,J         : INTEGER;
  205.  
  206. begin
  207.  
  208.   for I := 0 to 15 do         { Clear the Map }
  209.     for J := 1 to 8 do
  210.      Map[I,J] := 0;
  211.  
  212.   Map [1,1] := 1; Map [1,2] := 5; Map [1,3] := 6; Map [1,4] := 7;
  213.   Map [1,5] := 4;
  214.  
  215.   Map [2,1] := 1; Map [2,2] := 8; Map [2,3] := 7; Map [2,4] := 6;
  216.   Map [2,5] := 2;
  217.  
  218.   Map [3,1] := 2; Map [3,2] := 6; Map [3,3] := 7; Map [3,4] := 4;
  219.  
  220.   Map [4,1] := 2; Map [4,2] := 5; Map [4,3] := 8; Map [4,4] := 7;
  221.   Map [4,5] := 3;
  222.  
  223.   Map [5,1] := 1; Map [5,2] := 5; Map [5,3] := 2; Map [5,4] := 9;
  224.   Map [5,5] := 3; Map [5,6] := 7; Map [5,7] := 4;
  225.  
  226.   Map [6,1] := 1; Map [6,2] := 8; Map [6,3] := 7; Map [6,4] := 3;
  227.  
  228.   Map [7,1] := 3; Map [7,2] := 7; Map [7,3] := 4;
  229.  
  230.   Map [8,1] := 3; Map [8,2] := 6; Map [8,3] := 5; Map [8,4] := 8;
  231.   Map [8,5] := 4;
  232.  
  233.   Map [9,1] := 1; Map [9,2] := 5; Map [9,3] := 6; Map [9,4] := 3;
  234.  
  235.   Map [10,1] := 1; Map [10,2] := 8; Map [10,3] := 4; Map [10,4] := 9;
  236.   Map [10,5] := 2; Map [10,6] := 6; Map [10,7] := 3;
  237.  
  238.   Map [11,1] := 2; Map [11,2] := 6; Map [11,3] := 3;
  239.  
  240.   Map [12,1] := 2; Map [12,2] := 5; Map [12,3] := 8; Map [12,4] := 4;
  241.  
  242.   Map [13,1] := 1; Map [13,2] := 5; Map [13,3] := 2;è
  243.   Map [14,1] := 1; Map [14,2] := 8; Map [14,3] := 4;
  244.  
  245. end;  { InitMap }
  246.  
  247. procedure FindClusterType(ContourLevel : INTEGER);
  248.  
  249.       { Figure out which type of cluster this is. }
  250. type
  251.       PowerArrayType  = ARRAY[1..4] of INTEGER;
  252.  
  253. var
  254.       I           : INTEGER;
  255.  
  256.       Sum         : REAL;
  257.  
  258.       PowerArray  : PowerArrayType;
  259. begin
  260.   Sum := 0.00;
  261.   for I := 1 to 4 do
  262.     begin
  263.       if Point[I] >= ContourLevel
  264.       then PowerArray[I] := 1
  265.       else PowerArray[I] := 0;
  266.  
  267.       Sum := Sum + Point[I];
  268.     end;
  269.  
  270.   Point[5] := round(Sum / 4.0);
  271.  
  272.   if Point[5] < ContourLevel
  273.     then
  274.       begin
  275.       for I := 1 to 4 do
  276.         if PowerArray[I] = 1
  277.             then PowerArray[I] := 0
  278.             else PowerArray[I] := 1;
  279.       end;
  280.  
  281.       { This is the Cluster type number. }
  282.  
  283.   MapIndex := PowerArray[1] + (PowerArray[2] * 2)
  284.             + (PowerArray[3] * 4) + (PowerArray[4] * 8);
  285.  
  286. end;  {FindClusterType}
  287.  
  288. procedure GetTravArray;
  289.  
  290.       { Generate the Traversal array(s) from the map. A couple of
  291.          cluster types use two Traversal arrays. These are marked in
  292.          the map by a 9 separating the two traversal paths.
  293.         A map entry of 0 means that there is nowhere else to go. }
  294.  
  295. var
  296.       Edge,è      J,K,L       : INTEGER;
  297.  
  298. begin
  299.   J := 2;         { Clear the Traverse Array. }
  300.   for K := 1 to MaxEdgesToTraverse do
  301.       Traverse[J,K] := 0;
  302.  
  303.   J := 1;
  304.   for K := 1 to MaxEdgesToTraverse do
  305.       Traverse[J,K] := 0;
  306.  
  307.   K := 1;
  308.   L := 1;
  309.  
  310.   repeat
  311.     Edge := Map[MapIndex,L];
  312.     if Edge = 9
  313.       then        { Handle the two path cells. }
  314.         begin
  315.             Traverse[J,K] := 0;
  316.             J := J + 1;
  317.             K := 1;
  318.         end
  319.       else        { A normal cell or a two path not at sep. }
  320.         begin
  321.             Traverse[J,K] := Edge;
  322.             K := K + 1;
  323.         end;
  324.     L := L + 1;
  325.   until (Edge = 0);
  326.  
  327. end;  {GetTravArray}
  328.  
  329. procedure DrawCell( BaseX, BaseY, ContourLevel : INTEGER);
  330.  
  331.       { This procedure draws a cell. }
  332.  
  333. var
  334.       I,J         :INTEGER;
  335.  
  336.       FirstPoint  : BOOLEAN;
  337.  
  338. function Interpolate( PointA, PointB : INTEGER): REAL;
  339.  
  340.       { This function performs the edge interpolation. }
  341.  
  342. var
  343.       Wide,
  344.       ConWidth    : REAL;
  345.  
  346. begin
  347.  
  348.   if PointB > PointA
  349.     then
  350.       beginè      Wide := PointB - PointA;
  351.       ConWidth := PointB - ContourLevel;
  352.       Interpolate := 1.0 - (ConWidth / Wide);
  353.       end
  354.     else
  355.       begin
  356.       Wide := PointA - PointB;
  357.       ConWidth := PointA - ContourLevel;
  358.       Interpolate := ConWidth / Wide;
  359.       end;
  360. end;  {Interpolate}
  361.  
  362. procedure FindXY( Edge :INTEGER; VAR X, Y :REAL);
  363.  
  364. {     Finds the actual X and Y coordinates where the contour
  365.         crosses the edge. X and Y are relative to point 1
  366.         which is the lower right hand corner. }
  367.  
  368. begin
  369.       case Edge of
  370.       1 : begin
  371.             X := 0.0;
  372.             Y := Interpolate(Point[1], Point[2]);
  373.           end;
  374.  
  375.       2 : begin
  376.             X := Interpolate(Point[2], Point[3]);
  377.             Y := 1.0;
  378.           end;
  379.  
  380.       3 : begin
  381.             X := 1.0;
  382.             Y := Interpolate(Point[4], Point[3]);
  383.           end;
  384.  
  385.       4 : begin
  386.             X := Interpolate(Point[1], Point[4]);
  387.             Y := 0.0;
  388.           end;
  389.  
  390.       5 : begin
  391.             X := Interpolate( Point[2], Point[5])/2.0;
  392.             Y := 1.0 - X;
  393.           end;
  394.  
  395.       6 : begin
  396.             X :=  1.0 - (Interpolate( Point[3], Point[5]) /2.0);
  397.             Y := X;
  398.           end;
  399.  
  400.       7 : begin
  401.             Y := Interpolate( Point[4], Point[5]) / 2.0;
  402.             X := 1.0 - Y;
  403.           end;
  404. è      8 : begin
  405.             Y := Interpolate( Point[1], Point[5]) / 2.0;
  406.             X := Y;
  407.           end;
  408.     end;  {case}
  409. end; { FindXY }
  410.  
  411. procedure DrawContourLine;
  412.  
  413. {     It draws the lines. }
  414.  
  415. var
  416.       X,Y   : REAL;
  417.  
  418. begin
  419.   while Traverse[I,J] <> 0 do
  420.     begin
  421.       FindXY( Traverse[I,J], X, Y);
  422.       CurrentX := BaseX - round( X / XScale);
  423.       CurrentY := BaseY - round( Y / YScale);
  424.       if FirstPoint
  425.         then MoveTo( CurrentX, CurrentY)
  426.         else DrawTo( CurrentX, CurrentY);
  427.       J := J + 1;
  428.       FirstPoint := FALSE;
  429.     end;
  430. end;  {DrawContourLine}
  431.  
  432. begin  {DrawCell}
  433.  
  434.   MoveTo( BaseX, BaseY);
  435.  
  436.   FirstPoint := TRUE;
  437.   I := 1;
  438.   J := 1;
  439.   DrawContourLine;
  440.   if Traverse[2,1] <> 0
  441.     then
  442.       begin
  443.       I := 2;
  444.       J := 1;
  445.       FirstPoint := TRUE;
  446.       DrawContourLine;
  447.       end;
  448.    FirstPoint := TRUE;        {set up to move to next point, not draw}
  449. end;  {DrawCell}
  450.  
  451. procedure DrawContourAxes;
  452.  
  453. {     It draws the Contour Axes. }
  454.  
  455. begin
  456.   Tick   := ON;
  457.   Offset := 0;
  458.   DrawXAxis( Offset, Tick);è  DrawYAxis( Offset, Tick);
  459.   Tick   := OFF;
  460.   Offset := BoxTopOffset;
  461.   DrawXAxis( Offset, Tick);
  462.   Offset := BoxSideOffset;
  463.   DrawYAxis( Offset, Tick);
  464.   MoveTo( InitX, InitY);
  465. end;  {DrawContourAxes}
  466.  
  467. procedure VertScale;
  468.  
  469. { This procedure allows the user to select the amount of vertical
  470.       scale expansion needed.
  471. }
  472. var
  473.   GoodChoice            :BOOLEAN;
  474.  
  475.   Choice          :CHAR;
  476.  
  477. begin
  478.   repeat
  479.     GoodChoice := TRUE;
  480.     VExpand := TRUE;
  481.     writeln;
  482.     writeln( ' Please select a vertical scale expansion factor:');
  483.     writeln;
  484.     writeln('   A  1X Expansion (no change)');
  485.     writeln('   B  5X Expansion');
  486.     writeln('   C 10X Expansion');
  487.     writeln;
  488.     write(' Select A,B,or C: ');
  489.     readln(Choice);
  490.     Choice := UpCase(Choice);
  491.     case Choice of
  492.       'A'   : VExpand := FALSE;
  493.       'B'   : VExFactor :=  5.00;
  494.       'C'   : VExFactor := 10.00;
  495.       else GoodChoice := False;
  496.     end;
  497.   until GoodChoice;
  498. end; {VertScale}
  499.  
  500. PROCEDURE ContourParams(VAR ContourCount : INTEGER;
  501.                         VAR ContourValue : ContourValueType);
  502.  
  503. VAR
  504.   AcceptContours,
  505.   GoodContourCount  : BOOLEAN;
  506.  
  507.   DeltaPercent,
  508.   PercentLevel,
  509.   TopContourPercent : REAL;
  510.  
  511.   YesNo             : CHAR;
  512. èBEGIN
  513.  REPEAT
  514.   GoodContourCount := FALSE;
  515.   AcceptContours   := FALSE;
  516.  
  517.   repeat
  518.    writeln;
  519.    write(' How many contour levels do you want to use? (3-15) ');
  520.    readln(ContourCount);
  521.    if (ContourCount >= 3) AND (ContourCount < 16)
  522.     then GoodContourCount := TRUE;
  523.   until GoodContourCount;
  524.  
  525.   repeat
  526.    writeln;
  527.    write(' What top contour percent do you want to use?( > 0, <= 100) ');
  528.    readln(TopContourPercent);
  529.   until ((TopContourPercent > 0.00) AND (TopContourPercent <= 100.00));
  530.  
  531.   TopContourPercent := TopContourPercent/ 100.00;
  532.   writeln; writeln('  Contours at: ');
  533.   PercentLevel := 1.00;
  534.   for I := 1 to ContourCount do         { Calculate Contour Levels. }
  535.    begin
  536.     ContourValue[I] := round(MaxZ * TopContourPercent * PercentLevel);
  537.     case I of
  538.      1   : DeltaPercent := 0.10;
  539.      9   : DeltaPercent := 0.05;
  540.      11  : DeltaPercent := 0.02;
  541.     end; {case}
  542.     PercentLevel := PercentLevel - DeltaPercent;
  543.     writeln('  ', ContourValue[I],'  ',
  544.            ((ContourValue[I]/MaxZ)*100.0):5:2,' % of total');
  545.    end;
  546.   writeln; write(' Do you want to use these values? (Y/N): ');
  547.   readln(YesNo);
  548.   YesNo := UpCase(YesNo);
  549.    if YesNo = 'Y'
  550.     then AcceptContours := TRUE;
  551.  until AcceptContours;
  552. END;  {ContourParams}
  553.  
  554. begin  {Contour}
  555.   ClrScr;
  556.   FinalDisplayIndex := NumberOfDisplayArrays + 1;
  557.   TerminalCount := NumberOfDisplayArrays;
  558.   writeln; writeln('  ***** Contour Plotting Routine *****');
  559.   VertScale;
  560.   ContourParams(ContourCount, ContourValue);
  561.   Ready;
  562.   DrawContourAxes;
  563.   GetDate;
  564.   InitMap;
  565.   writeln('  Map initialization complete');
  566.   XScale := (NumberOfDisplayArrays - 1) / ContourXScale;è
  567.       { Read the first display array. }
  568.  
  569.   FileIndexOffset := 1;
  570.   FileIndex := 1;
  571.   StartEdge := 1;
  572.   EndEdge   := NumberOfDisplayPoints - 1;
  573.   YScale    := NumberOfDisplayPoints / ContourYScale;
  574.  
  575.   seek(DisplayFile, FileIndex);           {read the first display array}
  576.   read(DisplayFile, ContourArrayB);
  577.   FileIndex := FileIndex + FileIndexOffset;
  578.   if VExpand
  579.     then VerticalExpand;
  580.   MoveBToA;
  581.   DisplayCount := 1;
  582.  
  583.   repeat
  584.     seek(DisplayFile, FileIndex);   {read the next display array}
  585.     read(DisplayFile, ContourArrayB);
  586.  
  587.     if VExpand
  588.       then VerticalExpand;
  589.  
  590.     CellXPosition := round(DisplayCount / XScale) + ContourXOffset;
  591.  
  592.  { Extract the four corners of the current cell from the arrays}
  593.  
  594.     for RightCellEdge := StartEdge to EndEdge do
  595.       begin
  596.       Point[3] := ContourArrayA[RightCellEdge];
  597.       Point[4] := ContourArrayA[RightCellEdge + 1];
  598.       Point[2] := ContourArrayB[RightCellEdge];
  599.       Point[1] := ContourArrayB[RightCellEdge + 1];
  600.  
  601.       RightCellIndex := RightCellEdge - Startedge + 1;
  602.       CellYPosition := round( RightCellIndex / YScale) + ContourYOffset;
  603.  
  604.       for ContourNumber := 1 to ContourCount do
  605.         begin
  606.           FindClusterType( ContourValue[ContourNumber]);
  607.           if ((MapIndex > 0 ) AND (MapIndex < 15))
  608.             then
  609.               begin
  610.                 GetTravArray;
  611.                 DrawCell(CellXPosition, CellYPosition, ContourValue[ContourNumber]);
  612.               end;
  613.         end;
  614.       end;
  615.     FileIndex := FileIndex + FileIndexOffset;
  616.     DisplayCount := DisplayCount + 1;
  617.     MoveBToA;
  618.     write(chr(13),' Processing number: ',(FileIndex - 1));
  619.   until DisplayCount = TerminalCount;
  620.   MoveTo(0, 0);è  writeln;
  621. end;  {Contour}
  622.  
  623. begin {Contou}
  624.  
  625.   BEEP   := chr(7);           { Define ASCII BEL }
  626.   CR     := chr(13);          { Define ASCII CR  }
  627.   ESCAPE := chr(27);          { Define ASCII ESC }
  628.  
  629.   write('Enter the name of the display file: ');
  630.   readln(DisplayFileName);
  631.   assign(DisplayFile, DisplayFileName);
  632.   reset(DisplayFile);
  633.   ReadData;
  634.   Contour;
  635.   writeln(' End of plotting program.');
  636. end.
  637.  
  638.  
  639.  
  640.                          PROGRAM MkCon2;
  641.  
  642. {Make a test Contour Data set.}
  643.  
  644. const
  645.   NumberOfDisplayArrays    = 513;
  646.   NumberOfDisplayPoints    = 129;
  647.   XEnd                     = 5;
  648.   XStart                   = 0;
  649.   YEnd                     = 3;
  650.   YStart                   = 0;
  651.  
  652. type
  653.   DisplayArrayType         = ARRAY[1..NumberOfDisplayPoints] of INTEGER;
  654.   DisplayFileType          = FILE of DisplayArrayType;
  655.   FileNameType             = string[20];
  656.  
  657. var
  658.   DTemp,
  659.   I, J,
  660.   MaxZ          : INTEGER;
  661.  
  662.   STemp,
  663.   LTemp         : REAL;
  664.  
  665.   DisplayArray  : DisplayArrayType;
  666.   DisplayFile   : DisplayFileType;
  667.   FileName      : FileNameType;
  668.  
  669. procedure WriteData;
  670.  
  671. { Writes important data to element 0 of data array}
  672.  
  673. var
  674.   TempArray : DisplayArrayType;è
  675. begin
  676.  
  677.   TempArray[1] := NumberOfDisplayArrays;
  678.   TempArray[2] := NumberOfDisplayPoints;
  679.   TempArray[3] := MaxZ;
  680.   TempArray[4] := XEnd;
  681.   TempArray[5] := XStart;
  682.   TempArray[6] := YEnd;
  683.   TempArray[7] := YStart;
  684.  
  685.  
  686.   seek(DisplayFile, 0);
  687.   write(DisplayFile, TempArray);
  688. end;  {WriteData}
  689.  
  690. begin  {main}
  691.  
  692.  MaxZ := 0;
  693.  Writeln('Data generator for test of contour plotting software');
  694.  write('Enter name of file to be created:  ');
  695.  readln(FileName);
  696.  assign(DisplayFile, FileName);
  697.  rewrite(DisplayFile);
  698.  WriteData;
  699.  for I := 1 to NumberOfDisplayArrays do
  700.   begin
  701.    writeln(I);
  702.    LTemp := I / NumberOfDisplayArrays;
  703.    for J := 1 to NumberOfDisplayPoints do
  704.     begin
  705.      IF  (J < 65)
  706.       THEN STemp := J / 65;
  707.      IF  (J = 65)
  708.       THEN STemp := 1.0;
  709.      IF  (J > 90)
  710.       THEN STemp := (65 - (J - 65)) / 65;
  711.      DTemp := round(1000 * STemp * LTemp);
  712.      IF DTemp > MaxZ
  713.       then MaxZ := Dtemp;
  714.      DisplayArray[J] := Dtemp;
  715.     end;
  716.     seek(DisplayFile, I);
  717.     write(DisplayFile, DisplayArray);
  718.   end;
  719.  WriteData;
  720.  close(DisplayFile);
  721.  writeln('Contour data file generation complete');
  722. end.
  723.  
  724.  
  725.  
  726.                 {AMDEK AMPLOT-II Plotter drivers}
  727.  
  728. procedure MoveTo( XTo, YTo :INTEGER);è
  729. {     Moves the pen from:    LastX, LastY
  730.                     to:      XTo,   YTo  }
  731.  
  732. begin
  733.   write(AUX,'M', XTo, ',', YTo, CR);     {FOR AMDEK AMPLOT-II}
  734.   LastX := Xto;
  735.   LastY := Yto;
  736. end;  {MoveTo}
  737.  
  738. procedure DrawTo (XTo, YTo :INTEGER);
  739.  
  740. {     Drops the pen and draws a line from: LastX, LastY
  741.                                      to:   XTo,   YTo  }
  742.  
  743. begin
  744.   write(AUX,'D', XTo, ',', YTo, CR);      {FOR AMDEK AMPLOT-II}
  745.   LastX := XTo;
  746.   LastY := YTo;
  747. end;  {DrawTo}
  748.  
  749. procedure Ready;
  750.  
  751. {     It Prompts the user to get the plotter ready and hit return. }
  752.  
  753. var
  754.  Dummy    : CHAR;         {a real dummy variable}
  755.  
  756. begin
  757.   write(' Please get the plotter ready to go and hit return to start.');
  758.   write(BEEP, BEEP, BEEP, BEEP, BEEP);
  759.   readln;
  760.   read(Aux,Dummy);
  761.   write(AUX,'Z', CR, 'H', CR, 'J1', CR);         {FOR AMDEK AMPLOT-II}
  762.   LastX := 0;
  763.   LastY := 0;
  764. end;  {Ready}
  765.  
  766.  
  767. PROCEDURE PrintText(CharSize : CharSizeType; AlphaRotate : AlphaDirection);
  768.  
  769. {Prints text on the plotter}
  770.  
  771. var
  772.  I, StringLength   : INTEGER;
  773.  
  774. begin
  775.   case CharSize of
  776.    Small     : write(AUX, 'S30,18', CR);      {FOR AMDEK AMPLOT-II}
  777.    Medium    : write(AUX, 'S45,27', CR);      {FOR AMDEK AMPLOT-II}
  778.    Large     : write(AUX, 'S60,36', CR);      {FOR AMDEK AMPLOT-II}
  779.   end;  {case}
  780.  
  781.   StringLength := Length(TextString);
  782.   write(AUX, 'P');                   {FOR AMDEK AMPLOT-II}è  for I := 1 to StringLength do
  783.    write(AUX, TextString[I]);
  784.   write(AUX, CR);                    {FOR AMDEK AMPLOT-II}
  785. end;  {PrintText}
  786.  
  787. PROCEDURE Title;
  788. { Prints a title on the plot so you can identify it. }
  789.  
  790. begin
  791.  MoveTo(TitleXStart, TitleYStart);
  792.  TextString := DisplayFileName;
  793.  PrintText(Medium, Horizontal);
  794. end;  {Title}
  795.  
  796. procedure DrawXAxis( Offset :INTEGER; Tick :TickyType);
  797.  
  798. {     Draw an X axis with or without ticks and labels.
  799.       Definition of arguements:
  800.  
  801.             Offset   - an INTEGER which defines, in plotter units,
  802.                      an offset for the X axis from Y = InitY
  803.             Tick     - A structured type which, when set to "ON"
  804.                      causes ticks to be drawn on the axis.
  805. }
  806. var
  807.   XPos, YPos, I,
  808.   DeltaXLabel,
  809.   XVal, AxisEnd    : INTEGER;
  810.  
  811.   DXL, FXVal       : REAL;
  812.  
  813.   TenX             : BOOLEAN;
  814.  
  815. begin  {DrawXAxis}
  816.  YPos := InitY + Offset;
  817.  MoveTo(InitX, YPos);
  818.  IF Tick = ON
  819.   then
  820.    begin
  821.     write(AUX, 'X0,', LengthBetweenXTicks, ',10', CR);
  822.     XPos := InitX - XXCharOffset;
  823.     YPos := YPos - XYCharOffset;
  824.     MoveTo(XPos, YPos);
  825.     DXL := (XEnd - XStart) / 10.0;
  826.     DeltaXLabel := trunc(DXL);
  827.     FXVal := XStart;
  828.     XVal  := XStart;
  829.     IF DeltaXLabel < 1
  830.      THEN
  831.       BEGIN
  832.        TenX := TRUE;
  833.        Str(FXVal:3:1, TextString);
  834.       END
  835.      ELSE
  836.       BEGINè       TenX := FALSE;
  837.        Str(XVal, TextString);
  838.       END;
  839.     PrintText(Small, Horizontal);
  840.     FOR I := 1 to 10 do
  841.      begin
  842.       XPos := XPos + LengthBetweenXTicks;
  843.       MoveTo(XPos, YPos);
  844.       IF TenX
  845.        THEN
  846.         BEGIN
  847.          FXVal := FXVal + DXL;
  848.          Str(FXVal:3:1, TextString);
  849.         END
  850.        ELSE
  851.         BEGIN
  852.          XVal := XVal + DeltaXLabel;
  853.          Str(XVal, TextString);
  854.         END;
  855.       PrintText(Small, Horizontal);
  856.      end;
  857.    end
  858.   else
  859.    begin
  860.     AxisEnd := InitX + (LengthBetweenXTicks * 10);
  861.     DrawTo(AxisEnd, YPos);
  862.    end;
  863.  
  864. end;  {DrawXAxis}
  865.  
  866. procedure DrawYAxis( Offset :INTEGER; Tick :TickyType);
  867.  
  868. {     Draws a ticked or unticked unskewed Y axis.
  869.  
  870.       Definition of arguements:
  871.  
  872.             Offset   - an INTEGER which defines, in plotter units,
  873.                      an offset for the Y axis from X = InitX
  874.             Tick     - A structured type which, when set to "ON"
  875.                      causes ticks to be drawn on the axis.
  876. }
  877. var
  878.   XPos, YPos, I,
  879.   DeltaYLabel,
  880.   YVal, AxisEnd    : INTEGER;
  881.  
  882.   DYL, FYVal       : REAL;
  883.  
  884.   TenX             : BOOLEAN;
  885.  
  886. begin  {DrawYAxis}
  887.  XPos := InitX + Offset;
  888.  MoveTo(XPos, InitY);
  889.  IF Tick = ON
  890.   thenè   begin
  891.     write(AUX, 'X1,', LengthBetweenYTicks, ',10', CR);
  892.     XPos := XPos - YXCharOffset;
  893.     YPos := InitY - YYCharOffset;
  894.     MoveTo(XPos, YPos);
  895.     DYL := (YEnd - YStart) / 10.0;
  896.     DeltaYLabel := trunc(DYL);
  897.     FYVal := YStart;
  898.     YVal  := YStart;
  899.     IF DeltaYLabel < 1
  900.      THEN
  901.       BEGIN
  902.        TenX := TRUE;
  903.        Str(FYVal:3:1, TextString);
  904.       END
  905.      ELSE
  906.       BEGIN
  907.        TenX := FALSE;
  908.        Str(YVal, TextString);
  909.       END;
  910.     PrintText(Small,Vertical);
  911.     FOR I := 1 to 10 do
  912.      begin
  913.       YPos := YPos + LengthBetweenYTicks;
  914.       MoveTo(XPos, YPos);
  915.       IF TenX
  916.        THEN
  917.         BEGIN
  918.          FYVal := FYVal + DYL;
  919.          Str(FYVal:3:1, TextString);
  920.         END
  921.        ELSE
  922.         BEGIN
  923.          YVal := YVal + DeltaYLabel;
  924.          Str(YVal, TextString);
  925.         END;
  926.       PrintText(Small,Vertical);
  927.      end;
  928.    end
  929.   else
  930.    begin
  931.     AxisEnd := InitY + (LengthBetweenYTicks * 10);
  932.     DrawTo(XPos, AxisEnd);
  933.    end;
  934. end;  {DrawYAxis}
  935.  
  936.  
  937.